Import Libraries: Also setting working directory.

library(tidyr)
library(dbplyr)
library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.1     ✔ purrr     1.0.1
✔ forcats   1.0.0     ✔ readr     2.1.4
✔ ggplot2   3.4.2     ✔ stringr   1.5.0
✔ lubridate 1.9.2     ✔ tibble    3.2.1
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::ident()  masks dbplyr::ident()
✖ dplyr::lag()    masks stats::lag()
✖ dplyr::sql()    masks dbplyr::sql()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(lubridate)
library(ggplot2)
library(ggfortify)
library(plotly)

Attaching package: 'plotly'

The following object is masked from 'package:ggplot2':

    last_plot

The following object is masked from 'package:stats':

    filter

The following object is masked from 'package:graphics':

    layout
library(forecast)
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
Registered S3 methods overwritten by 'forecast':
  method                 from     
  autoplot.Arima         ggfortify
  autoplot.acf           ggfortify
  autoplot.ar            ggfortify
  autoplot.bats          ggfortify
  autoplot.decomposed.ts ggfortify
  autoplot.ets           ggfortify
  autoplot.forecast      ggfortify
  autoplot.stl           ggfortify
  autoplot.ts            ggfortify
  fitted.ar              ggfortify
  fortify.ts             ggfortify
  residuals.ar           ggfortify
setwd('C:/Users/cy_su/PycharmProjects/DSCI_605_Data_Visualizations/Module 5/M5_Lab4/')

Read the data from the CSV file: Convert the “Date” column to a datetime format Filter the data for the desired two-year period.

data <- read.csv("Fouryears_all.csv")

data$Date <- ymd_hms(data$Date)

start_date <- as.Date("2019-09-01")
end_date <- as.Date("2021-09-01")
filtered_data <- data %>%
  filter(Date >= start_date & Date <= end_date & Primary.Type == "BATTERY")

Data Wrangling: Aggregate the data by hourly intervals. Display the aggregated data.

data_hourly <- filtered_data %>%
  mutate(Hour = floor_date(Date, "hour")) %>%
  group_by(Hour) %>%
  summarise(Count = n()) %>%
  ungroup()

Time Series Visualization Create a time series object. Plot the time series. Show the plot. Save the image.

What I did to improve the visualization: 1. Changed Line Color and Type. 2. Added point density. 3. Legend and Title Positions 4. Added a color palette

plot <- ggplot(data = data_hourly, aes(x = Hour, y = Count)) +
  geom_smooth(aes(color = "Count"), se = FALSE, size = 1.2, linetype = "solid") +
  geom_point(size = 2, color = "blue", alpha = 0.5) +
  scale_x_datetime(date_labels = "%b %d, %Y", date_breaks = "1 day") +
  scale_color_brewer(palette = "Set1", name = "Metrics") +
  labs(x = "Date (Year-Month-Day)",
       y = "Count",
       title = "2-Year Series of Battery Crimes In California",
       subtitle = "Hourly Data Aggregated by Day",
       caption = "Source: Chicago Police Department’s CLEAR (Citizen Law Enforcement Analysis and Reporting) System") +
  theme_minimal() +
  theme(axis.text = element_text(size = 10, color = "darkblue"),
        axis.title = element_text(size = 12, face = "bold"),
        plot.title = element_text(size = 18, face = "bold", hjust = 0.5),
        plot.subtitle = element_text(size = 12, face = "italic", hjust = 0.5),
        plot.caption = element_text(size = 8, hjust = 1),
        legend.position = "bottom",
        panel.grid.major = element_line(color = "gray", size = 0.1),
        panel.grid.minor = element_line(color = "gray", size = 0.05),
        plot.background = element_rect(fill = "aliceblue")) +
  guides(color = guide_legend(override.aes = list(size = 4)))
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.
Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
ℹ Please use the `linewidth` argument instead.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.
ggsave("ts_plot.png")
Saving 7 x 5 in image
`geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
plotly_plot <- ggplotly(plot)
`geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
plotly_plot

Decompose the Time Series: Convert decomposed object to a data frame. Plot the data using autoplot. Save the image.

data_ts <- ts(data_hourly$Count, frequency = 24) # Adjust frequency as needed

data_ts_decomposed <- decompose(data_ts)

autoplot(data_ts_decomposed)

ggsave("ts_decomposed_plot.png")
Saving 7 x 5 in image

Create a MSTS Object: Decompose the object. Plot the object. Save the image.

battery_msts <- msts(data_hourly$Count, seasonal.periods = c(24,24*7,24*30))

battery_msts_decompose <- mstl(battery_msts)

autoplot(battery_msts_decompose)

ggsave("ts_msts_plot.png")
Saving 7 x 5 in image
LS0tDQp0aXRsZTogIk01X0xhYjRfVGltZV9zZXJpZXNfaW5fUl9jcmltZV9kYXRhX0NvZHlfWW9yayINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCioqSW1wb3J0IExpYnJhcmllczoqKiBBbHNvIHNldHRpbmcgd29ya2luZyBkaXJlY3RvcnkuDQpgYGB7cn0NCmxpYnJhcnkodGlkeXIpDQpsaWJyYXJ5KGRicGx5cikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShsdWJyaWRhdGUpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KGdnZm9ydGlmeSkNCmxpYnJhcnkocGxvdGx5KQ0KbGlicmFyeShmb3JlY2FzdCkNCg0Kc2V0d2QoJ0M6L1VzZXJzL2N5X3N1L1B5Y2hhcm1Qcm9qZWN0cy9EU0NJXzYwNV9EYXRhX1Zpc3VhbGl6YXRpb25zL01vZHVsZSA1L001X0xhYjQvJykNCmBgYA0KDQoqKlJlYWQgdGhlIGRhdGEgZnJvbSB0aGUgQ1NWIGZpbGU6KioNCkNvbnZlcnQgdGhlICJEYXRlIiBjb2x1bW4gdG8gYSBkYXRldGltZSBmb3JtYXQNCkZpbHRlciB0aGUgZGF0YSBmb3IgdGhlIGRlc2lyZWQgdHdvLXllYXIgcGVyaW9kLg0KYGBge3J9DQpkYXRhIDwtIHJlYWQuY3N2KCJGb3VyeWVhcnNfYWxsLmNzdiIpDQoNCmRhdGEkRGF0ZSA8LSB5bWRfaG1zKGRhdGEkRGF0ZSkNCg0Kc3RhcnRfZGF0ZSA8LSBhcy5EYXRlKCIyMDE5LTA5LTAxIikNCmVuZF9kYXRlIDwtIGFzLkRhdGUoIjIwMjEtMDktMDEiKQ0KZmlsdGVyZWRfZGF0YSA8LSBkYXRhICU+JQ0KICBmaWx0ZXIoRGF0ZSA+PSBzdGFydF9kYXRlICYgRGF0ZSA8PSBlbmRfZGF0ZSAmIFByaW1hcnkuVHlwZSA9PSAiQkFUVEVSWSIpDQpgYGANCg0KKipEYXRhIFdyYW5nbGluZzoqKg0KQWdncmVnYXRlIHRoZSBkYXRhIGJ5IGhvdXJseSBpbnRlcnZhbHMuDQpEaXNwbGF5IHRoZSBhZ2dyZWdhdGVkIGRhdGEuDQpgYGB7cn0NCmRhdGFfaG91cmx5IDwtIGZpbHRlcmVkX2RhdGEgJT4lDQogIG11dGF0ZShIb3VyID0gZmxvb3JfZGF0ZShEYXRlLCAiaG91ciIpKSAlPiUNCiAgZ3JvdXBfYnkoSG91cikgJT4lDQogIHN1bW1hcmlzZShDb3VudCA9IG4oKSkgJT4lDQogIHVuZ3JvdXAoKQ0KDQpgYGANCg0KKipUaW1lIFNlcmllcyBWaXN1YWxpemF0aW9uKioNCkNyZWF0ZSBhIHRpbWUgc2VyaWVzIG9iamVjdC4NClBsb3QgdGhlIHRpbWUgc2VyaWVzLg0KU2hvdyB0aGUgcGxvdC4NClNhdmUgdGhlIGltYWdlLg0KDQpXaGF0IEkgZGlkIHRvIGltcHJvdmUgdGhlIHZpc3VhbGl6YXRpb246DQogICAgMS4gQ2hhbmdlZCBMaW5lIENvbG9yIGFuZCBUeXBlLg0KICAgIDIuIEFkZGVkIHBvaW50IGRlbnNpdHkuDQogICAgMy4gTGVnZW5kIGFuZCBUaXRsZSBQb3NpdGlvbnMNCiAgICA0LiBBZGRlZCBhIGNvbG9yIHBhbGV0dGUNCmBgYHtyfQ0KcGxvdCA8LSBnZ3Bsb3QoZGF0YSA9IGRhdGFfaG91cmx5LCBhZXMoeCA9IEhvdXIsIHkgPSBDb3VudCkpICsNCiAgZ2VvbV9zbW9vdGgoYWVzKGNvbG9yID0gIkNvdW50IiksIHNlID0gRkFMU0UsIHNpemUgPSAxLjIsIGxpbmV0eXBlID0gInNvbGlkIikgKw0KICBnZW9tX3BvaW50KHNpemUgPSAyLCBjb2xvciA9ICJibHVlIiwgYWxwaGEgPSAwLjUpICsNCiAgc2NhbGVfeF9kYXRldGltZShkYXRlX2xhYmVscyA9ICIlYiAlZCwgJVkiLCBkYXRlX2JyZWFrcyA9ICIxIGRheSIpICsNCiAgc2NhbGVfY29sb3JfYnJld2VyKHBhbGV0dGUgPSAiU2V0MSIsIG5hbWUgPSAiTWV0cmljcyIpICsNCiAgbGFicyh4ID0gIkRhdGUgKFllYXItTW9udGgtRGF5KSIsDQogICAgICAgeSA9ICJDb3VudCIsDQogICAgICAgdGl0bGUgPSAiMi1ZZWFyIFNlcmllcyBvZiBCYXR0ZXJ5IENyaW1lcyBJbiBDYWxpZm9ybmlhIiwNCiAgICAgICBzdWJ0aXRsZSA9ICJIb3VybHkgRGF0YSBBZ2dyZWdhdGVkIGJ5IERheSIsDQogICAgICAgY2FwdGlvbiA9ICJTb3VyY2U6IENoaWNhZ28gUG9saWNlIERlcGFydG1lbnTigJlzIENMRUFSIChDaXRpemVuIExhdyBFbmZvcmNlbWVudCBBbmFseXNpcyBhbmQgUmVwb3J0aW5nKSBTeXN0ZW0iKSArDQogIHRoZW1lX21pbmltYWwoKSArDQogIHRoZW1lKGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gMTAsIGNvbG9yID0gImRhcmtibHVlIiksDQogICAgICAgIGF4aXMudGl0bGUgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDEyLCBmYWNlID0gImJvbGQiKSwNCiAgICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTgsIGZhY2UgPSAiYm9sZCIsIGhqdXN0ID0gMC41KSwNCiAgICAgICAgcGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTIsIGZhY2UgPSAiaXRhbGljIiwgaGp1c3QgPSAwLjUpLA0KICAgICAgICBwbG90LmNhcHRpb24gPSBlbGVtZW50X3RleHQoc2l6ZSA9IDgsIGhqdXN0ID0gMSksDQogICAgICAgIGxlZ2VuZC5wb3NpdGlvbiA9ICJib3R0b20iLA0KICAgICAgICBwYW5lbC5ncmlkLm1ham9yID0gZWxlbWVudF9saW5lKGNvbG9yID0gImdyYXkiLCBzaXplID0gMC4xKSwNCiAgICAgICAgcGFuZWwuZ3JpZC5taW5vciA9IGVsZW1lbnRfbGluZShjb2xvciA9ICJncmF5Iiwgc2l6ZSA9IDAuMDUpLA0KICAgICAgICBwbG90LmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbCA9ICJhbGljZWJsdWUiKSkgKw0KICBndWlkZXMoY29sb3IgPSBndWlkZV9sZWdlbmQob3ZlcnJpZGUuYWVzID0gbGlzdChzaXplID0gNCkpKQ0KDQpnZ3NhdmUoInRzX3Bsb3QucG5nIikNCg0KcGxvdGx5X3Bsb3QgPC0gZ2dwbG90bHkocGxvdCkNCg0KcGxvdGx5X3Bsb3QNCg0KDQpgYGANCg0KKipEZWNvbXBvc2UgdGhlIFRpbWUgU2VyaWVzOioqDQpDb252ZXJ0IGRlY29tcG9zZWQgb2JqZWN0IHRvIGEgZGF0YSBmcmFtZS4NClBsb3QgdGhlIGRhdGEgdXNpbmcgYXV0b3Bsb3QuDQpTYXZlIHRoZSBpbWFnZS4NCmBgYHtyfQ0KZGF0YV90cyA8LSB0cyhkYXRhX2hvdXJseSRDb3VudCwgZnJlcXVlbmN5ID0gMjQpICMgQWRqdXN0IGZyZXF1ZW5jeSBhcyBuZWVkZWQNCg0KZGF0YV90c19kZWNvbXBvc2VkIDwtIGRlY29tcG9zZShkYXRhX3RzKQ0KDQphdXRvcGxvdChkYXRhX3RzX2RlY29tcG9zZWQpDQoNCmdnc2F2ZSgidHNfZGVjb21wb3NlZF9wbG90LnBuZyIpDQpgYGANCg0KDQoqKkNyZWF0ZSBhIE1TVFMgT2JqZWN0OioqDQpEZWNvbXBvc2UgdGhlIG9iamVjdC4NClBsb3QgdGhlIG9iamVjdC4NClNhdmUgdGhlIGltYWdlLg0KYGBge3J9DQpiYXR0ZXJ5X21zdHMgPC0gbXN0cyhkYXRhX2hvdXJseSRDb3VudCwgc2Vhc29uYWwucGVyaW9kcyA9IGMoMjQsMjQqNywyNCozMCkpDQoNCmJhdHRlcnlfbXN0c19kZWNvbXBvc2UgPC0gbXN0bChiYXR0ZXJ5X21zdHMpDQoNCmF1dG9wbG90KGJhdHRlcnlfbXN0c19kZWNvbXBvc2UpDQoNCmdnc2F2ZSgidHNfbXN0c19wbG90LnBuZyIpDQpgYGANCg==